home *** CD-ROM | disk | FTP | other *** search
/ PC Open 100 / PC Open 100 CD 1.bin / CD1 / INTERNET / EMAIL / pop file / setup.exe / POPFile / MQ.pm < prev    next >
Encoding:
Perl POD Document  |  2004-01-27  |  4.5 KB  |  154 lines
  1. # POPFILE LOADABLE MODULE
  2. package POPFile::MQ;
  3.  
  4. use POPFile::Module;
  5. @ISA = ( "POPFile::Module" );
  6.  
  7. #----------------------------------------------------------------------------
  8. #
  9. # This module handles POPFile's message queue.  Every POPFile::Module is
  10. # able to register with the MQ for specific message types and can also
  11. # send messages without having to know which modules need to receive
  12. # its messages.
  13. #
  14. # Message delivery is asynchronous and guaranteed.
  15. #
  16. # The following public functions are defined:
  17. #
  18. # register() - register for a specific message type and pass an object
  19. #              reference.  will call that object's deliver() method to
  20. #              deliver messages
  21. #
  22. # post()     - send a message of a specific type
  23. #
  24. # The current list of types is
  25. #
  26. #     UIREG    Register a UI component, message is the component type
  27. #              and the parameter is a the element and reference to the
  28. #              object registering (comes from any component)
  29. #
  30. #     TICKD    Occurs when an hour has passed since the last TICKD (this
  31. #              is generated by the POPFile::Logger module)
  32. #
  33. #     LOGIN    Occurs when a proxy logs into a remote server, the message
  34. #              is the username sent
  35. #
  36. #     NEWFL    Occurs when a new file has been written to the history
  37. #              cache on disk.  The message is the filename
  38. #
  39. # Copyright (c) 2001-2003 John Graham-Cumming
  40. #
  41. #   This file is part of POPFile
  42. #
  43. #   POPFile is free software; you can redistribute it and/or modify
  44. #   it under the terms of the GNU General Public License as published by
  45. #   the Free Software Foundation; either version 2 of the License, or
  46. #   (at your option) any later version.
  47. #
  48. #   POPFile is distributed in the hope that it will be useful,
  49. #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  50. #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  51. #   GNU General Public License for more details.
  52. #
  53. #   You should have received a copy of the GNU General Public License
  54. #   along with POPFile; if not, write to the Free Software
  55. #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  56. #
  57. #----------------------------------------------------------------------------
  58.  
  59. use strict;
  60. use warnings;
  61. use locale;
  62.  
  63. #----------------------------------------------------------------------------
  64. # new
  65. #
  66. #   Class new() function
  67. #----------------------------------------------------------------------------
  68. sub new
  69. {
  70.     my $type = shift;
  71.     my $self = POPFile::Module->new();
  72.  
  73.     # These are the individual queues of message, indexed by type
  74.     # and written to by post().
  75.  
  76.     $self->{queue__} = {};
  77.  
  78.     # These are the registered objects for each type
  79.  
  80.     $self->{waiters__} = {};
  81.  
  82.     bless $self, $type;
  83.  
  84.     $self->name( 'mq' );
  85.  
  86.     return $self;
  87. }
  88.  
  89. # ---------------------------------------------------------------------------------------------
  90. #
  91. # service
  92. #
  93. # Called to handle pending tasks for the module.  Here we flush all queues
  94. #
  95. # ---------------------------------------------------------------------------------------------
  96. sub service
  97. {
  98.     my ( $self ) = @_;
  99.  
  100.     # Iterate through all the messages in all the queues
  101.  
  102.     for my $type (sort keys %{$self->{queue__}}) {
  103.          while ( my $ref = shift @{$self->{queue__}{$type}} ) {
  104.              for my $waiter (@{$self->{waiters__}{$type}}) {
  105.                 my $message   = @$ref[0];
  106.                 my $parameter = @$ref[1];
  107.  
  108.                 $waiter->deliver( $type, $message, $parameter );
  109.             }
  110.         }
  111.     }
  112.  
  113.     return 1;
  114. }
  115.  
  116. #----------------------------------------------------------------------------
  117. #
  118. # register
  119. #
  120. #   When a module wants to receive specific message types it calls this
  121. #   method with the type of message is wants to receive and the address
  122. #   of a callback function that will receive the messages
  123. #
  124. #   $type        A string identifying the message type
  125. #   $callback    Reference to a function that takes three parameters
  126. #
  127. #----------------------------------------------------------------------------
  128. sub register
  129. {
  130.     my ( $self, $type, $callback ) = @_;
  131.  
  132.     push @{$self->{waiters__}{$type}}, ( $callback );
  133. }
  134.  
  135. #----------------------------------------------------------------------------
  136. #
  137. # post
  138. #
  139. #   Called to send a message through the message queue
  140. #
  141. #   $type        A string identifying the message type
  142. #   $message     The message
  143. #   $parameter   Parameters to the message
  144. #
  145. #----------------------------------------------------------------------------
  146. sub post
  147. {
  148.     my ( $self, $type, $message, $parameter ) = @_;
  149.  
  150.     push @{$self->{queue__}{$type}}, [ $message, $parameter ];
  151. }
  152.  
  153. 1;
  154.